home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS Toolkit
/
BBS Toolkit.iso
/
rbbs_pc
/
dc174v11.zip
/
RSB1DROP.MRG
< prev
next >
Wrap
Text File
|
1992-07-18
|
10KB
|
198 lines
* ------------[ BLED merge (c) Ken Goosens ]-------------
* Merge this against RBBSSUB1.BAS to produce RBBSSUB1.NEW
* RBBSSUB1.BAS: Date 6-20-1992 Size 55569 bytes
* DROP174 (c) 1992 by Richie Molinelli
* ------------[ Created 07-18-1992 02:19:31 ]------------
* REPLACING old line(s) by new
' $linesize:132
' $title: 'RBBS-SUB1.BAS 17.4, Copyright 1986-92 by D. Thomas Mack'
' Copyright 1990 by D. Thomas Mack, all rights reserved.
' Name ...............: RBBSSUB1.BAS
' First Released .....: June 21, 1992
' Subsequent Releases.:
' Copyright ..........: 1986-1992
' Purpose.............:
' Subprorams that require error trapping are incorporated
' within RBBSSUB1.BAS as separately callable subroutines
' in order to free up as much code as possible within
' the 64WasK code segment used by RBBS-PC.BAS.
' Parameters..........: Most parameters are passed via a COMMON statement.
'
' Subroutine Line Function of Subroutine
' Name Number
' ChangeDir 20101 Change subdirectory
' CheckInt 58360 Check input is valid integer
' CommPut 59275 Write string to communications port
* ------[ first line different ]------
' DropCarrier 63901 Change users security level with excessive carrier drops ' DROP174
' FindFile 59790 Determine whether a file exists without opening it
' FindFree 51098 Find amount of space on the upload disk drive
' FindItX 20219 Find if a file exists on a device
' FindUser 12598 Find a user in the USERS file
' FlushCom 20308 Read all characters in the communications port
' GetCom 1418 Read a character from the communications port
' GetPassword 58280 Read RBBS-PC's "PASSWORD" file
' GETWRK 58330 Read record from file number 2
' KillWork 58258 Delete a RBBS-PC "WORK" file
' NetBIOS 20898 Lock/Unlock NetBIOS semaphore files
' OpenCom 200 Open communications port (number 3)
' OpenFMS 58188 Open the upload management system directory
' OpenOutW 28218 Open RBBS-PC's "WORK" file (number 2) for output
' OpenRSeq 1479 Open a sequential file (number 2) for random I/O
' OpenUser 9398 Open the USER file (number 5)
' OpenWork 57978 Open RBBS-PC's work file (number 2)
' OpenWorkA 58340 Open RBBS-PC's "WORK" file (number 2) for append
' Printit 13673 Print line on the local PC printer
' PrintWork 58320 Print string to file #2 w/o CR/LF
' PrintWorkA 58350 Print string to file #2 with CR/LF
' PutCom 59650 Write to the communications port
' PutWork 59660 Write to work file randomly
' RBBSPlay 59680 Plays a musical string
' ReadAny 58310 Read file number 2 into ZOutTxt$
' ReadDef 112 Read configuration file
' ReadDir 58290 Read entire lines
' ReadParmsX 58300 Read certain number of parameters from specified file
' Talk 59700 RBBS-PC Voice synthesizer support for sight impaired
' SetCall 108 Find where next callers record is
' UpdateC 43048 Update the caller's file with elasped session time
' UpdtCalr 13661 Update to the caller's file
'
' $INCLUDE: 'RBBS-VAR.BAS'
'
* REPLACING old line(s) by new
9400 CLOSE 5
IF ZShareIt THEN _
OPEN ZActiveUserFile$ FOR RANDOM SHARED AS #5 LEN=128 _
ELSE OPEN "R",5,ZActiveUserFile$,128
WasI# = LOF(5)
LastRec = FIX(WasI#/128)
FIELD 5,31 AS ZUserName$, _
15 AS ZPswd$, _
2 AS ZSecLevel$, _
14 AS ZUserOption$, _
24 AS ZCityState$, _
* ------[ first line different ]------
1 AS MachineType$, _ ' DROP174
1 AS ZDropTimes$, _ ' DROP174
1 AS ZBankTime$,_
4 AS ZTodayDl$, _
4 AS ZTodayBytes$, _
4 AS ZDlBytes$, _
4 AS ZULBytes$, _
14 AS ZLastDateTimeOn$, _
3 AS ZListNewDate$, _
2 AS ZUserDnlds$, _
2 AS ZUserUplds$, _
2 AS ZElapsedTime$
FIELD 5,128 AS ZUserRecord$
END SUB
* REPLACING old line(s) by new
58280 ' $SUBTITLE: 'GetPassword - sub to read the "passwords" file'
' $PAGE
'
' NAME -- GetPassword
'
' PARAMETER MEANING
' INPUTS -- FILE # 2 OPENED
'
' OUTPUTS -- ZTempPassword$
' ZTempSecLevel
' ZTempTimeAllowed
' ZTempRegPeriod
' ZTempMaxPerDay
'
' PURPOSE -- To read the RBBS-PC "PASSWORDS" file
'
SUB GetPassword STATIC
ON ERROR GOTO 65000
ZErrCode = 0
INPUT #2,ZTempPassword$, ZTempSecLevel, _
ZTempTimeAllowed, ZTempMaxPerDay, _
ZTempRegPeriod, ZTempExpiredSec, _
ZStartTime, ZEndTime, _
ZByteMethod, ZRatioRestrict#, _
ZInitialCredit#, ZTempTimeLock, _
* ------[ first line different ]------
ZTempMaxBank, ZDropCarSecChng, _ ' DROP174
ZDropIncrement ' DROP174
* REPLACING old line(s) by new
59790 ' $SUBTITLE: 'FindFile -- subroutine to find a file'
' $PAGE
'
' NAME -- FindFile
'
' INPUTS -- PARAMETER MENANING
' FilName$ NAME OF FILE TO LOOK FOR
' FExists WHETHER FILE EXISTS
'
' OUTPUTS -- RETURNED.VALUE VALUE RETURNED
' TRUE = FILE EXISTS
' TRUE = FILE DOES NOT EXIST
'
' PURPOSE -- Determine whether passed file FilName$ exists
' Unlike, FindIt, this routine does not open any
' file and, hence, does not create one in determining
' whether a file exists.
'
SUB FindFile (FilName$,FExists) STATIC
CALL BadFileChar (FilName$,FExists)
59791 IF FExists THEN _
IOErrorCount = 0 : _
CALL RBBSFind (FilName$,WasZ,WasY,WasM,WasD) : _
FExists = (WasZ = 0)
END SUB
* ------[ first line different ]------
* INSERTING new line(s)
' ' DROP174
63901 '$SUBTITLE: 'DropCarrier -- Subroutine to change users sec level' ' DROP174
' $PAGE ' DROP174
' ' DROP174
' NAME: DropCarrier ' DROP174
' ' DROP174
' PURPOSE: To change a users security level who is dropping carrier ' DROP174
' excessively ' DROP174
' ' DROP174
' INPUTS: ZDropCarSecChng ' DROP174
' ZDropIncrement ' DROP174
' ZDropTimes ' DROP174
' ' DROP174
' WRITTEN BY: Richie Molinelli - 7/12/92 ' DROP174
' ' DROP174
SUB DropCarrier STATIC ' DROP174
63902 IF ZDropCarSecChng = 0 THEN _ ' DROP174
EXIT SUB ' DROP174
IF ZDropTimes > ZDropCarSecChng THEN _ ' DROP174
ZDropTimes = ZDropCarSecChng - 1 ' DROP174
IF ZDropChange = ZFalse THEN ' DROP174
ZDropTimes = ZDropTimes + 1 ' DROP174
IF ZDropTimes MOD ZDropCarSecChng <> 0 THEN ' DROP174
ZGlobalDropTimes = ZDropTimes ' DROP174
ZDropChange = ZTrue ' DROP174
EXIT SUB ' DROP174
END IF ' DROP174
ZUserSecLevel = ZUserSecLevel - ZDropIncrement ' DROP174
ZSubParm = 6 ' DROP174
CALL FileLock ' DROP174
CALL OpenUser (HighestUserRecord) ' DROP174
GET 5,ZUserFileIndex ' DROP174
LSET ZSecLevel$ = MKI$(ZUserSecLevel) ' DROP174
IF ZUserFileIndex > 0 AND ZUserFileIndex < 32768 THEN _ ' DROP174
PUT 5,ZUserFileIndex ' DROP174
ZSubParm = 8 ' DROP174
CALL FileLock ' DROP174
ZDropChange = ZTrue ' DRIP174
CALL UpdtCalr ("Security reset for Dropped Carriers!",2) ' DROP174
ZDropTimes = 0 ' DROP174
ZGlobalDropTimes = ZDropTimes ' DROP174
ZSubParm = -1 ' DROP174
END IF ' DROP174
END SUB ' DROP174
' ' DROP174
' $SUBTITLE: 'Error Handling for separately compiled subroutines'
' $PAGE
'
'
' Error handling for the separately compiled subroutines of RBBS-PC
'
'